Aminet 1 (Walnut Creek)/Aminet - June 1993 [Walnut Creek].iso/usenet/sources/volume91/aplictns/mandel10/part03

Internet Message Format | 1991-02-18 | 57KB

Path: news.larc.nasa.gov!amiga-request
From: [e-mail] (Amiga Sources/Binaries Moderator)
Subject: v91i019: Mandel 1.0 - yet another mandelbrot, Part03/04
Reply-To: [e-mail] (Hannu Helminen ti)
Newsgroups: comp.sources.amiga
Message-ID: <comp.sources.amiga:[e-mail]>
References: <comp.sources.amiga:[e-mail]>
Date: 18 Feb 91 22:25:43 GMT
Approved: [e-mail] (Tad Guy)
X-Mail-Submissions-To: [e-mail]
X-Post-Discussions-To: comp.sys.amiga.misc

Submitted-by: [e-mail] (Hannu Helminen ti)
Posting-number: Volume 91, Issue 019
Archive-name: applications/mandel-1.0/part03

#!/bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#        "End of archive 3 (of 4)."
# Contents:  source/brot.asm source/gui.asm.aa
# Wrapped by tadguy@ab20 on Mon Feb 18 17:25:40 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'source/brot.asm' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'source/brot.asm'\"
else
echo shar: Extracting \"'source/brot.asm'\" \(26440 characters\)
sed "s/^X//" >'source/brot.asm' <<'END_OF_FILE'
X
X* This file: brot version 1.00
X
X* (c) 1990 by H. Helminen
X
X* This program will draw Mandelbrot set.
X* It uses two advanced features:
X
X* 1) Contour Crawling
X*    When this feature is enabled, I will follow the edge
X*    of each area of same colour and assume the interior
X*    is of same color. This is true for ideal set, but because
X*    of digital sampling, some errors may occur.
X*    NOTE: This method is very sensitive to errors that may occur
X*          if you change the code, e.g.
X*    o   pixel colors must not be changed during draw
X*    o   draw must not go out of screen bounds
X*    o   if screen is not clear prior to drawing,
X*        uncleared areas may be left untouched
X*    o   draw must start at an edge of the picture
X
X*    If disabled, every single pixel is calculated individually
X*    resulting a bit better accuracy, a lot slower computing time.
X*    When drawing disconnected Julia sets, crawling should be
X*    disabled since it would produce inaccurate pictures.
X*    Setting the AUTOCRAWL bit in mb_flags will do that for you.
X
X* 2) 32-bit fixed point arithmetics
X*    To speed this program up (standard A500 with 68000 and no
X*    FP-processors) while keeping reasonable resolution, I used
X*    signed 32-bit fixed point arithmetics, shifted left by 29
X*    bits. Multiplication was somewhat cumbersome.
X*    This format allows a resolution of about 1.9 x 10^(-9).
X*    When the resolution needed is much less accurate, one can use
X*    only 16 bits in multiplication. Typically one would use
X*    16 bits when delta > 0.0001 .. 0.0005.
X
X*    Setting the AUTOPREC flag in mb_flags will do that for you.
X*    However, in order to produce accurate pictures of Julia sets
X*    that have complex structure near origo, you may need to
X*    set the HIGH flag by yourself.
X
X* Typical computing times for whole set with 100 iterations
X* (5-bitplane 320 x 256 lores screen, no competing 68000 activity)
X
X*        crawl  walk (=traditional pixel-by-pixel method)
X* 16-bit  0:49   2:12
X* 32-bit  1:29   5:33
X
X* And, of course, the author:
X
X* |_|_  _   _|    _  _  _  _  _   _ _  _  ,|_ _  _
X* (_| )(/_ (_|(_|| )(_|(/_(_)| ) | ) )(_|/)(_(/_|
X*                    _)
X* Hannu Helminen [e-mail]
X
X* This proggie is quite useless by itself.
X* You should (b)link it with pipe.o (by me, of course).
X* Or you could use stack.o, which may be visually more attractive
X* but uses more memory.
X* This proggie is full of references to "stack", please ignore.
X
X* You could use brot with your own programs. Just pass
X* a valid MandelBrot structure in a0 with all fields initialized.
X* (see mbrot.i) The RastPort's *must* have valid TmpRas and AreaInfo
X* structures attached to it.
X
X* Or, link it with gui.o (again by me)
X
X* BUGS: MANY, including:
X
X* - not very smart handling of AUTOCRAWL, since non-connected
X*   set _could_ be crawled provided that before areafilling an
X*   area, a few points in the interior were checked to make sure
X*   that they are of same color.
X* - AUTOPREC will fail on Julia sets with complex structre near origo.
X
X   NOLIST
X   INCLUDE  "macros.i"
X   INCLUDE  "mbrot.i"
X
X   XREF     _AbsExecBase
X
X* If you insist... poof, you can remove the equates and use includes.
X* I however prefer shorter compiles.
X
X
X* These are used to maintain a stack-like dynamically allocated structure.
X* (I like these functions ... only entry points are visible to this proggie)
X
X   XREF     f_push
X   XREF     f_pull
X   XREF     f_clear
X
X* Now make myself visible to others.
X
X   XDEF     MandelBrot
X
X   LIST
X
X
X
X   SECTION  main,CODE
X
XMandelBrot:
X         push     d0-d7/a0-a6
X
X* Save mbrot structure to a4. It can stay there all the time...
X         move.l   a0,a4
X
X         move.l   _AbsExecBase,a6
X         lea      GfxName,a1
X         moveq    #0,d0
X
X         Call     OpenLibrary
X         tst.l    d0
X         beq      exit_mb
X         move.l   d0,a6
X
X* If precision is AUTOPREC, determine which precision we actually use.
X         btst.b   #MBB_AUTOPREC,mb_flags(a4)
X         beq.s    skip_low
X         bset.b   #MBB_HIGH,mb_flags(a4)
X
X         cmp.l    #DELTALIMIT,mb_dx(a4)
X         blo.s    skip_low
X         cmp.l    #DELTALIMIT,mb_dy(a4)
X         blo.s    skip_low
X         bclr.b   #MBB_HIGH,mb_flags(a4)
X
Xskip_low:
X
X* If AUTOCRAWL is set, determine whether we should crawl or no.
X         btst.b   #MBB_AUTOCRAWL,mb_flags(a4)
X         beq.s    skip_crawl
X         bset.b   #MBB_CRAWL,mb_flags(a4)
X
X* Mandelbrot set is always connected, so it may be crawled
X         btst.b   #MBB_JULIA,mb_flags(a4)
X         beq.s    skip_crawl
X
X* Julia set should be crawled if and only if corresponding
X* c = jx + jy i belongs to Mandelbrot set.
X* LS: like that "if and only if"?
X         move.l   mb_jx(a4),d6
X         move.l   mb_jy(a4),d7
X         move.w   mb_i(a4),d3    ; use same number of iterations
X
X         bsr      iterate
X         tst.w    d3
X         bmi.s    skip_crawl     ; inside the set!
X
X         bclr.b   #MBB_CRAWL,mb_flags(a4)
X
Xskip_crawl:
X
X* clear area prior to drawing.
X         move.l   mb_RastPort(a4),a5
X         move.l   a5,a1
X         move.w   #CLEAR,d0
X         Call     SetAPen
X         move.l   a5,a1
X         move.w   mb_x1(a4),d0
X         move.w   mb_y1(a4),d1
X         move.w   mb_x2(a4),d2
X         move.w   mb_y2(a4),d3
X         Call     RectFill
X
X* start drawing...
X         btst.b   #MBB_CRAWL,mb_flags(a4)
X         beq.s    walk_mb
X
X         bsr      Crawling
X         bra.s    exit_mb
Xwalk_mb:
X         bsr      Walking
Xexit_mb:
X         move.l   a6,a1
X         move.l   _AbsExecBase,a6
X         Call     CloseLibrary
X         pull     d0-d7/a0-a6
Xno_gfx:
X         rts
X
XWalking:
X         move.w   mb_x1(a4),d4
X         move.w   mb_y1(a4),d5
X         move.w   d4,d6
X         move.w   mb_x2(a4),d7
X         move.w   mb_y2(a4),d3
X1$:
X
X         bsr      Pixel
X         bsr      Break
X         bne.s    3$
X         addq.w   #1,d4
X         cmp.w    d7,d4
X         blo.s    1$
X         bsr      Pixel
X
X         addq.w   #1,d5
X         cmp.w    d3,d5
X         bhi.s    3$
X2$:
X         bsr      Pixel
X         bsr      Break
X         bne.s    3$
X         subq.w   #1,d4
X         cmp.w    d6,d4
X         bhi.s    2$
X         bsr      Pixel
X
X         addq.w   #1,d5
X         cmp.w    d3,d5
X         bls.s    1$
X3$:
X         rts
X
X
XCrawling:
X         move.w   mb_y1(a4),d0
X         or.w     #%1100000000000000,d0   ; initial direction down
X         swap     d0
X         move.w   mb_x1(a4),d0
X1$:
X         bsr.s    Crawl    ; return with Z clear if user issued break
X         bne.s    2$
X         bsr      f_pull
X         bne.s    1$       ; stack non-empty
X
X2$:
X* Clear stack ... important in case someone used ^C
X         bsr      f_clear
X         rts
X
X
X* "Crawl" is supposed to take care of the actual crawling.
X* When handed with a pixel & direction in d0, it will find
X* its way through the edge of area with same colour.
X
X* In addition, it will push all pixels _not_ in that area
X* to stack.
X
X* d0 format: ddyyyyyy yyyyyyyy xxxxxxxx xxxxxxxx
X
X* direction bits:
X*     00
X*   01  10
X*     11
X
X
XCrawl:
X         push     d0-d7
X         move.w   d0,d4       ; x
X         swap     d0
X         move.w   d0,d5
X         and.w    #%0011111111111111,d5   ; y
X         move.w   d0,d3
X         and.w    #%1100000000000000,d3   ; d (high 2 bits)
X
X* If all pixels are drawn, it seems to me this area has already been
X* crawled (if not so, there are other pixels in the stack...)
X         bsr      Test4
X         tst.w    d0
X         bpl.s    1$          ; All pixels next to me were drawn
X
X         move.w   d4,d6    ; Save place & dir until come to same place again
X         move.w   d5,d7
X         move.w   d3,d2
X
X         move.l   a5,a1
X         move.l   d4,d0
X         move.l   d5,d1
X         bsr      AreaMove    ; note: This is a subroutine, not library call
X2$:
X         bsr.s    proceed
X         move.l   a5,a1
X         move.l   d4,d0
X         move.l   d5,d1
X         bsr      AreaDraw    ; and so is this
X         bsr      Break
X         bne.s    3$
X         cmp.w    d4,d6       ; Compare with initial place & direction
X         bne.s    2$
X         cmp.w    d5,d7
X         bne.s    2$
X         cmp.w    d3,d2
X         bne.s    2$
X
X         move.l   a5,a1
X         move.l   d4,d0
X         move.l   d5,d1
X         Call     ReadPixel
X         move.l   a5,a1
X         Call     SetAPen     ; Just in case no pixels were drawn above.
X         move.l   a5,a1
X         bsr      AreaEnd     ; this
X1$:      moveq    #0,d0
X         bra.s    4$
X3$:
X         move.l   a5,a1
X         bsr      AreaEnd     ; This finishes any draw (subroutine)
X         moveq    #-1,d0
X4$:
X         pull     d0-d7
X         rts                  ; This routine returns same as Break
X
X
X* Proceed: This routine finds edge of an area of uniform color.
X* d4/d5 = pixel, d3 = direction. Returns next pixel & direction
X* along the edge.
X* Lets give an example: let's assume current pixel is A. (a colour)
X* X is known to be != A. b and c are yet unknown.
X* Last direction was up.
X*
X* b c
X* A X
X*
X* check b
X* if (A != b) then
X*    direction = left
X*    push b
X* else
X*    check c
X*    if (A != c) then
X*       current pixel = b
X*       push c
X*    else
X*       direction = right
X*       current pixel = c
X*
X
Xproceed:
X         push     d0/d2/d6-d7
X         bsr      Pixel
X         move.w   d0,d2    ; color of current pixel
X
X         move.w   d4,d6
X         move.w   d5,d7    ; save normal pixel so we can resume
X
X         bsr.s    front
X         bsr      Pixel    ; check "b"
X         cmp.w    d0,d2
X         beq.s    1$
X
X* Turn left.
X         tst.w    d3
X         bpl.s    2$
X         eor.w    #%0100000000000000,d3
X2$:
X         add.w    #%0100000000000000,d3
X         bpl.s    3$
X         eor.w    #%0100000000000000,d3
X3$:
X* Luckily, d3/d6/d7 now contain just right info for pushing.
X         tst.w    d0
X         bmi.s    7$       ; do not push if pixel was outside
X         tst.l    d0
X         bmi.s    7$       ; if pixel drawn, dont push it.
X         move.w   d5,d0
X         or.w     d3,d0
X         eor.w    #%1100000000000000,d0   ; opposite direction
X         swap     d0
X         move.w   d4,d0
X         bsr      f_push
X7$:
X         move.w   d6,d4    ; resume pixel
X         move.w   d7,d5
X         bra.s    4$       ; DONE...
X
X1$:
X         move.w   d4,d6    ; save "forwarded" pixel so we can resume
X         move.w   d5,d7
X
X         bsr.s    right
X         bsr      Pixel    ; check "c"
X         cmp.w    d0,d2
X         beq.s    5$
X
X* Go forward
X* This is what I call luck: again the right components for pushing
X         tst.w    d0
X         bmi.s    8$       ; again, if outside, dont push.
X         tst.l    d0
X         bmi.s    8$       ; dont push drawn pixels either
X         move.w   d5,d0
X         or.w     d3,d0
X         eor.w    #%1100000000000000,d0
X         swap     d0
X         move.w   d4,d0
X         bsr      f_push
X8$:
X         move.w   d6,d4    ; resumes pixel to what it was before 'bsr right'
X         move.w   d7,d5
X         bra.s    4$       ; DONE
X
X5$:
X* Turn to right
X         tst.w    d3
X         bpl.s    6$
X         eor.w    #%0100000000000000,d3
X6$:
X         add.w    #%1100000000000000,d3
X         bpl.s    4$
X         eor.w    #%0100000000000000,d3
X4$:
X         pull     d0/d2/d6-d7
X         rts
X
X* move one pixel d3-wards.
Xfront:
X         tst.w    d3
X         bmi.s    1$
X         btst.w   #14,d3
X         bne.s    2$
X
X         subq.w   #1,d5    ; 00
X         rts
X2$:      subq.w   #1,d4    ; 01
X         rts
X1$:
X         btst.w   #14,d3
X         bne.s    3$
X         addq.w   #1,d4    ; 10
X         rts
X3$:      addq.w   #1,d5    ; 11
X         rts
X
X* move one pixel to the right of direction d3.
Xright:
X         tst.w    d3
X         bmi.s    1$
X         btst.w   #14,d3
X         bne.s    2$
X
X         addq.w   #1,d4    ; 00
X         rts
X2$:      subq.w   #1,d5    ; 01
X         rts
X1$:
X         btst.w   #14,d3
X         bne.s    3$
X         addq.w   #1,d5    ; 10
X         rts
X3$:      subq.w   #1,d4    ; 11
X         rts
X
X* Test4 will test if all 4 pixels next to d4,d5 are drawn.
X* If so, a negative number will be returned in d0.
X
XTest4:
X         move.l   d3,-(a7)
X         moveq    #0,d3
X
X         subq.w   #1,d4
X         bsr.s    GetPixel
X         or.w     d0,d3       ; if any of these is negative ...
X
X         addq.w   #2,d4
X         bsr.s    GetPixel
X         or.w     d0,d3       ; (meaning pixel was not drawn) ...
X         subq.w   #1,d4
X
X         subq.w   #1,d5
X         bsr.s    GetPixel
X         or.w     d0,d3       ; -1 will get written all over d3
X
X         addq.w   #2,d5
X         bsr.s    GetPixel
X         or.w     d0,d3
X         subq.w   #1,d5
X
X         move.w   d3,d0
X         move.l   (a7)+,d3
X         rts
X
X* This routine is also called with screen pixel in d4,d5.
X* (GfxBase = a6, RastPort = a5)
X* It will return pixel color in d0 (but NOT draw it)
X* If pixel is outside region, 0 will be returned.
X* If it is not drawn, -1 will be returned
X
XGetPixel:
X         push     d1/a0-a1
X         moveq    #0,d0      ; d0 will be ready just in case any
X         cmp.w    mb_x1(a4),d4       ; of the conditions below is met
X         blo      1$
X         cmp.w    mb_x2(a4),d4
X         bhi      1$
X         cmp.w    mb_y1(a4),d5
X         blo      1$
X         cmp.w    mb_y2(a4),d5
X         bhi      1$
X
X         move.l   a5,a1
X         move.l   d4,d0
X         move.l   d5,d1
X         Call     ReadPixel
X
X         cmp.w    #CLEAR,d0
X         bne.s    1$
X
X         moveq    #-1,d0
X1$:
X         pull     d1/a0-a1
X         rts
X
X* This routine is called with screen pixel in d4,d5.
X* (GfxBase = a6, RastPort = a5)
X* It will return pixel color in d0 and draw it if required.
X* If pixel is outside drawing region, -1 will be returned.
X
X* (An undocumented feature: if pixel was drawn before this
X* routine was called, bit 31 will be set.)
X
X* Another feature: pixels right of y-axis are returned
X* with bit 14 set (unless color == interior).
X* This will make separate areas on both sides of y-axis,
X* thus making it impossible to accidentally crawl around
X* the set (without noticing the interior at all)...
X
XPixel:
X         push     d1-d3/d6-d7/a0-a1
X         moveq    #0,d2
X         moveq    #-1,d0      ; d0 will be ready just in case any
X         cmp.w    mb_x1(a4),d4       ; of the conditions below is met
X         blo      pixel_outofbounds
X         cmp.w    mb_x2(a4),d4
X         bhi      pixel_outofbounds
X         cmp.w    mb_y1(a4),d5
X         blo      pixel_outofbounds
X         cmp.w    mb_y2(a4),d5
X         bhi      pixel_outofbounds
X
X         move.w   d4,d3
X         move.w   d3,d6
X         mulu     mb_dx(a4),d6   ; dx.hi * d2
X         swap     d6             ; calmly ignore any overflow
X         move.w   #0,d6
X         mulu     2+mb_dx(a4),d3 ; dx.lo * d2
X         add.l    d3,d6
X         add.l    mb_x0(a4),d6
X         bmi.s    pixel_left
X         move.w   #%0100000000000000,d2
Xpixel_left:
X         move.l   a5,a1
X         move.l   d4,d0
X         move.l   d5,d1
X         Call     ReadPixel
X
X         bset     #31,d0
X         cmp.w    #CLEAR,d0
X         bne.s    pixel_outofbounds       ; not clear -> dont draw (OBS! d0 still has color)
X
X         move.w   d5,d3
X         move.w   d3,d7
X         mulu     mb_dy(a4),d7
X         swap     d7
X         move.w   #0,d7
X         mulu     2+mb_dy(a4),d3
X         add.l    d3,d7
X         neg.l    d7       ; upwards increasing y coordinate
X         add.l    mb_y0(a4),d7
X
X         move.w   mb_i(a4),d3
X         sub.w    #2,d3
X         bpl.s    positive_i
X         moveq    #0,d3
Xpositive_i
X         bsr.s    iterate
X
X         cmp.w    #-1,d3
X         beq.s    pixel_inside_set
X
X         and.l    #$ffff,d3
X         divu     mb_colors(a4),d3
X         swap     d3          ; remainder
X         add.w    #FIRST,d3
X         bra.s    pixel_outside_set
Xpixel_inside_set:
X         move.w   #INTERIOR,d3
Xpixel_outside_set:
X         move.w   d3,d0
X         move.l   a5,a1
X         Call     SetAPen
X         move.w   d4,d0
X         move.w   d5,d1
X         move.l   a5,a1
X         Call     WritePixel
X         move.w   d3,d0
X         bclr     #31,d0
Xpixel_outofbounds:
X         cmp.w    #INTERIOR,d0
X         beq.s    pixel_dontOR
X         or.w     d2,d0
Xpixel_dontOR:
X         pull     d1-d3/d6-d7/a0-a1
X         rts
X
X
X* This is the soul of the MandelBrot set.
X* We iterate a point represented by x=d6 and y=d7 in our
X* numerical system. d3 is set to maximum number of iterations,
X* and will be decremented until -1 reached unless point is
X* found to be outside the set.
X* We find the point to be outside when |z| > 2
X
X* There are two versions of this routine, the former for 32 bits,
X* the latter for 16 bits.
X
X* For those who don't know the formula of Mandelbrot set:
X*
X* Point c = x + yi {x,y E R, i^2 = -1} is said to be in the M. set if
X*          2
X* z    = z   + c    , z  = c,
X*  n+1    n            0
X*
X* doesnt -> oo as n -> oo. (This routine is only approximation, n -> d3)
X
X* NEW: If client wants the user to see Julia sets, we handle them here.
X* The formula is the same, except: z0 is point and c is constant
X* throughout the set (it corresponds to a point in the M. set).
X* Hope you can complex math!
X
X
Xiterate:
X         btst.b   #MBB_HIGH,mb_flags(a4)
X         beq      iterate16
X
X         push     d0-d2/d4-d7
X
X* z is initialized with c
X         move.l   d6,d4    ; x0 -> x
X         move.l   d7,d5    ; y0 -> y
X
X* Julia stuff!
X         btst.b   #MBB_JULIA,mb_flags(a4)
X         beq.s    1$
X         move.l   mb_jx(a4),d6
X         move.l   mb_jy(a4),d7
X1$:
X* real part
X* (And as an intermission, find out if x^2 + y^2 > 2^2 or |z| > 2.
X*  Because our multiplication routine does not monitor overflow,
X*  we check the arguments first.)
X
X         move.l   d4,d0
X         bsr      square
X         move.l   d1,d2    ; x^2
X         add.l    d0,d0    ; |x| > 2 ?  d0 was reserved
X         bvs.s    3$
X
X         move.l   d5,d0
X         bsr      square     ; y^2
X         add.l    d0,d0    ; |y| > 2 ?
X         bvs.s    3$
X         move.l   d1,d0    ; |z| > 2 ?
X         add.l    d2,d0
X         bvs.s    3$
X
X         sub.l    d1,d2    ; x^2 - y^2
X         add.l    d6,d2    ;           + x0
X         bvs.s    2$
X
X* imaginary part
X         move.l   d4,d0
X         move.l   d5,d1
X         bsr      multi
X         add.l    d1,d1    ; 2 * x * y
X         bvs.s    2$
X         add.l    d7,d1                + y0
X         bvs.s    2$
X
X* get ready for next iteration:
X         move.l   d1,d5
X         move.l   d2,d4
X
X         dbf      d3,1$
X
X* This is more or less a kludge!
X* Testing if |z| < 2 should be last in our loop, before
X* dbf. Because it was first, low-level iterations
X* would show some sharp edges on the interior.
X* We need one more |z| < 2 here.
X* (The kludge is not removed because of speed reasons.)
X
X         move.l   d4,d0
X         bsr      square
X         move.l   d1,d2    ; x^2
X         add.l    d0,d0    ; |x| > 2 ?
X         bvs.s    3$
X
X         move.l   d5,d0
X         bsr      square   ; y^2
X         add.l    d0,d0    ; |y| > 2 ?
X         bvs.s    3$
X         add.l    d2,d1    ; |z| > 2 ?
X         bvc.s    2$
X
X* Thanks to our kludge, d3 has been decremented too much if
X* branched here. This would result in sharp edges on areas
X* outside the set as well. This time we have an easy fix:
X
X3$:      addq.w   #1,d3
X2$:
X         pull     d0-d2/d4-d7
X         rts
X
X* Square and multi are primary operations of signed fixed-point math.
X* Addition can be done using normal add.l instruction.
X
X* This routine does not monitor overflowing.
X* Its arguments are expected to be within the range -2 .. 2.
X
X* NOTE: all registers except d1 are preserved (including d0!)
X
X* square : d0^2 -> d1
X* multi: d0*d1 -> d1
X
Xsquare:  move.l   d0,d1
Xmulti:   push     d2-d5
X
X* We can only multiply with unsigned numbers.
X* So we calculate the sign of the result ahead of time.
X
X         move.l   d0,d2
X         bpl.s    1$
X         neg.l    d0       ; fix d0
X1$:
X         tst.l    d1
X         bpl.s    2$
X         neg.l    d1       ; fix d1
X         not.l    d2       ; but d2 has the sign of final result
X2$:
X         move.w   d1,d3
X         mulu     d0,d3    ; d3 = d0lo * d1lo
X         moveq    #29,d5   ; strip this much bits out of d3
X         lsr.l    d5,d3    ; (introduces rounding error of max. 1 bits)
X
X         swap     d0
X         move.w   d1,d4
X         mulu     d0,d4    ; d4 = d0h1 * d1lo
X         moveq    #13,d5   ; again some strip-tease
X         lsr.l    d5,d4    ; (and rounding errors)
X         add.l    d4,d3
X
X         swap     d1
X         move.w   d1,d4
X         mulu     d0,d4    ; d4 = d0hi * d1hi
X         lsl.l    #3,d4    ; now shift the other way up
X         add.l    d4,d3    ; if (-2)*(-2) this will overflow .. who cares?
X
X         swap     d0
X         mulu     d0,d1    ; d1 = d0lo * d1hi
X         lsr.l    d5,d1    ; shift .. d5 still has #13
X         add.l    d1,d3    ; all summed in d3
X
X         tst.l    d2
X         bpl.s    3$       ; test & fix sign of product
X         neg.l    d3
X3$:
X         move.l   d3,d1    ; result will be carried back in d1 (!)
X         pull     d2-d5
X         rts
X
X* The same routine with .w and with no bsr's to multi/square.
X* Comments have been stripped out, only changed parts are recommented.
X
XMULTI    macro
X            muls     d0,d1
X            asl.l    #3,d1
X            swap     d1
X         endm
XSQUARE   macro
X            move.w   d0,d1
X            muls     d0,d1
X            asl.l    #3,d1
X            swap     d1
X         endm
X
Xiterate16:
X         push     d0-d2/d4-d7
X         swap     d6          ; long -> word
X         swap     d7
X
X         move.w   d6,d4
X         move.w   d7,d5
X
X         btst.b   #MBB_JULIA,mb_flags(a4)
X         beq.s    1$
X         move.w   mb_jx(a4),d6   ; always remember: we want HIGH order bits
X         move.w   mb_jy(a4),d7
X1$:
X         move.w   d4,d0
X         SQUARE
X         move.w   d1,d2
X         add.w    d0,d0
X         bvs.s    3$
X         move.w   d5,d0
X         SQUARE
X         add.w    d0,d0
X         bvs.s    3$
X         move.w   d1,d0
X         add.w    d2,d0
X         bvs.s    3$
X         sub.w    d1,d2
X         add.w    d6,d2
X         bvs.s    2$
X
X         move.w   d4,d0
X         move.w   d5,d1
X         MULTI
X         add.w    d1,d1
X         bvs.s    2$
X         add.w    d7,d1
X         bvs.s    2$
X         move.w   d1,d5
X         move.w   d2,d4
X         dbf      d3,1$
X
X         muls     d5,d5    ; This part is slightly different
X         muls     d4,d4
X         add.l    d5,d4
X         bvs.s    3$
X         add.l    d4,d4
X         add.l    d4,d4
X         bvs.s    3$
X         add.l    d4,d4
X         bvc.s    2$
X
X3$:      addq.w   #1,d3
X2$:
X         pull     d0-d2/d4-d7
X         rts
X
X* General-purpose break-condition check.
X* Current version uses call-back procedures, because I could
X* not make it general enough.
XBreak:
X         push     a0/d0
X         move.l   mb_break(a4),d0
X         beq.s    1$
X         move.l   d0,a0
X         jsr      (a0)
X1$:
X         pull     a0/d0
X         rts
X
X* This group of routines essentially remove unnecessary points
X* and then call the real AreaXXXX routines.
X* Just because 6553 vectors seems to be a maximum.
X
X* One could code this by allocating one bitplane, setting bits accorging
X* to what is fed to AreaDraw, filling it with one raw blitter operation
X* and then BlitPattern()ing it to RastPort. This would save allocating
X* TmpRas and AreaInfo structures.
X
X* I am a perfectionist, but I aint a fool. This is a kludge, but so what?
X
XAreaMove:
X         move.w   d0,startx
X         move.w   d1,starty
X         move.w   d0,prevx
X         move.w   d1,prevy
X         clr.b    dir
X         Call     AreaMove
X         rts
XAreaDraw:
X         push     d2/d3
X         bsr.s    which_dir
X
X         tst.b    dir
X         bpl.s    skip_it
X
X* Now! All bits are not on same line.
X* More accurately, since we test this on every point, the current
X* point is not on same line as the previous ones. So:
X         move.w   d0,d2
X         move.w   d1,d3
X         move.w   prevx,d0    ; The previous was the last in line
X         move.w   prevy,d1
X         move.w   d0,startx   ; starting point of the new line
X         move.w   d1,starty
X         Call     AreaDraw
X         move.w   d2,d0       ; one-stage pipelining
X         move.w   d3,d1
X         clr.b    dir
X         bsr.s    which_dir   ; right direction for these first 2 bits.
Xskip_it:
X         move.w   d0,prevx
X         move.w   d1,prevy
Xdraw_done:
X         pull     d2/d3
X         rts
X
X* This routine keeps track of our heading.
X* dir carries the direction from previous stages, all 8 directions
X* are mapped to numbers 1..4 (opposite directions get same number).
X* If directions is undetermined so far, dir is 0.
X* -1 means pixels are no more on same line (requires AreaDraw.)
Xwhich_dir:
X         move.w   startx,d2
X         move.w   starty,d3
X         sub.w    d0,d2
X         sub.w    d1,d3
X
X         tst.w    d2       ; normalize (make opposite dirs equal)
X         bpl.s    pos_1
X         neg.w    d2
X         neg.w    d3
Xpos_1
X         tst.w    d3
X         bpl.s    pos_2
X         neg.w    d2
X         neg.w    d3
Xpos_2
X
X         tst.w    d2       ; now determine direction.
X         beq.s    dir_03
X         bpl.s    dir_12
X;dir4
X         add.w    d2,d3
X         bne.s    dir_illegal ; not diagonal!
X         moveq    #4,d2
X         bra.s    dir_proc
Xdir_12
X         tst.w    d3
X         beq.s    dir_1
X;dir_2
X         cmp.w    d2,d3
X         bne.s    dir_illegal ; not diagonal!
X         moveq    #2,d2
X         bra.s    dir_proc
Xdir_1
X         moveq    #1,d2
X         bra.s    dir_proc
Xdir_03
X         tst.w    d3
X         beq.s    dir_0
X;dir_3
X         moveq    #3,d2
X         bra.s    dir_proc
Xdir_0
X         moveq    #0,d2
X         bra.s    dir_proc
Xdir_illegal
X         moveq    #-1,d2
Xdir_proc
X         move.b   dir,d3
X         beq.s    dir_valid
X         tst.b    d2
X         beq.s    dir_OK
X         cmp.b    d2,d3
X         beq.s    dir_OK
X;neither valid!
X         move.b   #-1,dir
X         rts
Xdir_valid
X         move.b   d2,dir
Xdir_OK
X         rts
X
X
XAreaEnd:
X         move.l   a1,-(a7)
X         move.w   prevx,d0
X         move.w   prevy,d1
X         Call     AreaDraw    ; force dirty buffers out
X         move.l   (a7)+,a1
X         Call     AreaEnd
X         rts
X
X* Needed by my Area routines
X
Xprevx       ds.w  1
Xprevy       ds.w  1
Xstartx      ds.w  1
Xstarty      ds.w  1
Xdir         ds.b  1
X
X* perhaps this should be a section of its own.
X
XGfxName     dc.b  'graphics.library',0
X
X         end
X
END_OF_FILE
if test 26440 -ne `wc -c <'source/brot.asm'`; then
    echo shar: \"'source/brot.asm'\" unpacked with wrong size!
fi
# end of 'source/brot.asm'
fi
if test -f 'source/gui.asm.aa' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'source/gui.asm.aa'\"
else
echo shar: Extracting \"'source/gui.asm.aa'\" \(26145 characters\)
sed "s/^X//" >'source/gui.asm.aa' <<'END_OF_FILE'
X
X* This file: gui v1.00
X
X* (c) 1990 by H. Helminen
X
X* linkage information:
X* blink gui.o brot.o pipe.o to mandel lib amiga.lib
X
X* And now for something completely different:
X* A graphical user interface for MandelBrot.
X
X* of course by The DM (Hannu Helminen, [e-mail])
X
X* BUGS: many, including
X* - coordinates in screen title may trash window title bar
X* - if not enough memory, 56 bytes will disappear.
X
X            NOLIST
X            INCLUDE  "macros.i"
X            INCLUDE  "mbrot.i"
X            INCLUDE  "iff.i"
X            INCLUDE  "exec/lists.i"
X            INCLUDE  "exec/memory.i"
X            INCLUDE  "exec/ports.i"
X            INCLUDE  "exec/alerts.i"
X            INCLUDE  "devices/timer.i"
X            INCLUDE  "libraries/dos.i"
X            INCLUDE  "libraries/dosextens.i"
X            INCLUDE  "intuition/screens.i"
X            INCLUDE  "intuition/intuition.i"
X            INCLUDE  "workbench/workbench.i"
X            INCLUDE  "workbench/startup.i"
X
X            XREF     _LVOAlert
X
X* Misc defines
X
XDEPTH       EQU   5     ; # of bitplanes (use at least 3 (2 is minimum))
XSCREEN      EQU   0
X
X* SCREEN: Select one of the following:
X
X*        non-lace lace
X* lores     0       2
X* hires     1       3
X
X* SCREEN determines VIEWMODE, screen size and mb_dx/mb_dy scaling.
X* NOTE: if SCREEN > 0, max. magnification will be 28
X
X         ifeq  SCREEN-0
XVIEWMODE    EQU   0
XXSIZE       EQU   320      ; Size of screen
XYSIZE       EQU   256
X         endc
X         ifeq  SCREEN-1
XVIEWMODE    EQU   V_HIRES
XXSIZE       EQU   640
XYSIZE       EQU   256
X         endc
X         ifeq  SCREEN-2
XVIEWMODE    EQU   V_LACE
XXSIZE       EQU   320
XYSIZE       EQU   512
X         endc
X         ifeq  SCREEN-3
XVIEWMODE    EQU   V_HIRES|V_LACE
XXSIZE       EQU   640
XYSIZE       EQU   512
X         endc
X
XWINX        EQU   20      ; Place & size of info window
XWINY        EQU   20
XWINW        EQU   148
XWINH        EQU   80
X
XRASSIZE     EQU   ((XSIZE+15)/16*2)*YSIZE
XMAXVECT     EQU   6553  ; Cant get bigger than this. (Sigh.)
X
XNORMAL_X    EQU   0
XNORMAL_Y    EQU   0
XNORMAL_JX   EQU   0
XNORMAL_JY   EQU   0
XNORMAL_I    EQU   100
XNORMAL_ZOOM EQU   $010000
XNORMAL_M    EQU   $060000
XMIN_M       EQU   $050000
X
X         ifeq  SCREEN
XMAX_M       EQU   $1d0000
X         endc
X         ifgt  SCREEN
XMAX_M       EQU   $1c0000
X         endc
X
XFLAGS1      EQU   ACTIVATE|BACKDROP|BORDERLESS|REPORTMOUSE|RMBTRAP|NOCAREREFRESH
XFLAGS2      EQU   WINDOWCLOSE|WINDOWDRAG|RMBTRAP|NOCAREREFRESH
X
XIDCMP1      EQU   MOUSEMOVE|MOUSEBUTTONS|RAWKEY
XIDCMP2      EQU   GADGETUP|GADGETDOWN|CLOSEWINDOW|RAWKEY
X
XFAKECLASS   EQU   3  ; This pretends to be one of IDCMP classes
X
XZOOM        EQU   0  ; these internal tokens represent method of zooming
XREDRAW      EQU   1
XRESET       EQU   2
X
XTRUE        EQU   1
XFALSE       EQU   0
X
X* Import brot entry point
X            XREF  MandelBrot
X
X* A simple macro that converts letters to upper case
Xtoupper  macro
X         cmp.b #'a',\1
X         blo.s no\@
X         sub.b #'a'-'A',\1
Xno\@:    ds.w  0           ; needed for assembler's sake.
X         endm
X
X
X            LIST
X
X
X            SECTION  main,CODE
X
X* This is where the actual code begins.
X         push     d1-d7/a0-a6
X
X         move.l   a0,a3
X         move.w   d0,d3
X
X* We need to find out whether we have been invoked from CLI or WorkBench
X         sub.l    a1,a1
X         Base     Exec
X         Call     FindTask
X         move.l   d0,a0          ; This is a process, right?
X         move.l   pr_CLI(a0),d0
X         beq.s    from_WB
X
X         clr.b    -1(a3,d3.w)
X         clr.l    WBmessage      ; from CLI
X         move.l   d0,a0
X         add.l    a0,a0          ; BPTR conversion
X         add.l    a0,a0
X         move.l   cli_CommandName(a0),a0  ; BSTR
X         add.l    a0,a0          ; BPTR conversion
X         add.l    a0,a0          ; now here we'll find a BCPL string...
X         move.b   (a0)+,d0       ; get len and goto first character
X         move.l   a0,MyName      ; save name
X         ext.w    d0
X         move.w   d0,MyNameLen   ; and length
X
X         bra.s    common_code
Xfrom_WB:
X         lea      pr_MsgPort(a0),a3
X         move.l   a3,a0
X         Call     WaitPort
X         move.l   a3,a0
X         Call     GetMsg
X         move.l   d0,WBmessage   ; Do not reply until ready to exit.
X
X         move.l   d0,a0
X         move.l   sm_ArgList(a0),d0 ; Argument list
X         beq.s    common_code
X         move.l   d0,a0
X         move.l   wa_Lock(a0),d2    ; lock to current directory
X         move.l   wa_Name(a0),a0
X         move.l   a0,MyName         ; save name
X         moveq    #-1,d1
X1$
X         addq.w   #1,d1
X         tst.b    (a0)+
X         bne.s    1$
X         move.w   d1,MyNameLen      ; and length
X
Xcommon_code:
X
X* Open some libraries
X         lea      _DosLib,a1
X         moveq    #0,d0
X         Call     OpenLibrary
X         move.l   d0,_DosBase
X         bne.s    dos_ok
X         ALERT    AG_OpenLib|AO_DOSLib
X         bra      nodos
Xdos_ok:
X         tst.l    WBmessage
X         beq.s    1$
X         move.l   d2,d1
X         Base     Dos
X         Call     CurrentDir
X         Base     Exec
X1$
X         lea      _IntuitionLib,a1
X         moveq    #0,d0
X         Call     OpenLibrary
X         move.l   d0,_IntuitionBase
X         bne.s    intui_ok
X         ALERT    AG_OpenLib|AO_Intuition
X         bra      nointui
Xintui_ok:
X         lea      _GfxLib,a1
X         moveq    #0,d0
X         Call     OpenLibrary
X         move.l   d0,_GfxBase
X         bne.s    gfx_ok
X         ALERT    AG_OpenLib|AO_GraphicsLib
X         bra      nogfx
Xgfx_ok:
X
X* Open timer.device
X         lea      _TimerDev,a0
X         moveq    #UNIT_VBLANK,d0
X         lea      IOreq,a1
X         moveq    #0,d1
X         Call     OpenDevice
X         tst.b    d0
X         beq.s    timer_ok
X         ALERT    AG_OpenDev|AO_TimerDev
X         bra      timererr
Xtimer_ok:
X* initialize msgport
X         lea      MsgPort,a2
X         move.b   #NT_MSGPORT,LN_TYPE(a2)
X         clr.b    LN_PRI(a2)
X         clr.l    LN_NAME(a2)
X         move.b   #PA_SIGNAL,MP_FLAGS(a2)    ; signal me when done
X
X         moveq    #-1,d0
X         move.b   #ERROR_nosignal,error
X         Call     AllocSignal          ; get a signal bit
X         tst.b    d0
X         bmi      nosignal
X         move.b   d0,MP_SIGBIT(a2)
X
X         sub.l    a1,a1
X         Call     FindTask
X         move.l   d0,MP_SIGTASK(a2)
X                                       ; task to be signalled
X         lea      MP_MSGLIST(a2),a0
X         NEWLIST  a0                   ; init link fields
X         lea      IOreq,a0
X         move.l   a2,MN_REPLYPORT(a0)
X         clr.l    UseReq               ; mark it as not being in use
X
X         move.l   a3,a0
X
X         lea      MyMandelBrot,a4
X
X         move.w   #0,mb_x1(a4)
X         move.w   #0,mb_y1(a4)
X         move.w   #XSIZE-1,mb_x2(a4)
X         move.w   #YSIZE-1,mb_y2(a4)
X
X* Defaults
X         move.b   #ERROR_none,error
X         move.w   #NORMAL_I,mb_i(a4)
X         move.b   #MBF_AUTOPREC|MBF_AUTOCRAWL,mb_flags(a4)
X         move.b   #TRUE,inter
X         move.b   #ZOOM,method
X         clr.b    isdrawn
X         clr.w    Counter
X         clr.b    saveit
X
X         move.l   #NORMAL_ZOOM,Zoom    ; 2^(-1) = 50%
X         move.l   #NORMAL_M,Magnify    ; 2^(-6) = 1/64
X         move.l   #NORMAL_X,CurrentX
X         move.l   #NORMAL_Y,CurrentY
X         move.l   #NORMAL_JX,mb_jx(a4)
X         move.l   #NORMAL_JY,mb_jy(a4)
X
X         lea      CtrlC,a1
X         move.l   a1,mb_break(a4)   ; Call-back procedure
X
X         move.w   #(1<<DEPTH)-2,mb_colors(a4)
X
X* This is again WB/CLI specific code, option processing
X         tst.l    WBmessage
X         beq      CLI_1
X
X* WB option stuff
X         Base     Exec
X         lea      _IconLib,a1
X         moveq    #0,d0
X         Call     OpenLibrary
X         tst.l    d0
X         bne.s    iconlib_ok
X* Currently this error is not reported...
X         move.b   #ERROR_iconlib,error
X         bra      options_done
Xiconlib_ok
X         move.l   d0,a6
X         move.l   MyName,a0
X         Call     GetDiskObject
X         tst.l    d0
X         bne.s    diskobject_ok
X         move.b   #ERROR_noicon,error
X         bra.s    close_icon_lib
Xdiskobject_ok
X         move.l   d0,a5          ; disk object
X         lea      WBjumptable,a2
X         lea      WBoptions,a3
Xbrowse_tools
X         tst.b    (a3)              ; The last in line?
X         beq.s    icons_done
X         move.l   do_ToolTypes(a5),a0
X         move.l   a3,a1
X         Call     FindToolType
X         move.l   (a2)+,a1          ; The actual address to jump to
X         tst.l    d0
X         beq.s    tool_notfound
X         move.l   d0,a0
X         jsr      (a1)
X         beq.s    wrong_option
Xtool_notfound
X         tst.b    (a3)+
X         bne.s    tool_notfound     ; Find next tool type
X         bra.s    browse_tools
Xwrong_option
X         move.b   #ERROR_tooltype,error
Xicons_done
X         move.l   a5,a0
X         Call     FreeDiskObject
Xclose_icon_lib
X         move.l   a6,a1
X         Base     Exec
X         Call     CloseLibrary
X         tst.b    error
X         bne      nosignal
X         bra.s    options_done
X
XCLI_1
X         lea      LongUsage,a3
X         move.l   #LongLen,d3
X         tst.b    (a0)
X         beq.s    options_done
X         cmp.b    #'?',(a0)
X         beq.s    usage
X
X         move.b   #ERROR_cmdline,error
X         lea      ShortUsage,a3
X         move.l   #ShortLen,d3
Xgetnext:
X         move.b   (a0)+,d0
X         beq.s    options_done
X         cmp.b    #' ',d0
X         beq.s    getnext
X         cmp.b    #8,d0
X         beq.s    getnext
X         cmp.b    #'-',d0
X         bne.s    usage
X
X         move.b   (a0)+,d0
X         lea      options,a1
X         lea      jumptable,a2
X
X         toupper  d0
Xgetopt:
X         move.l   (a2)+,a5
X         cmp.b    (a1)+,d0
X         bne.s    next
X         jsr      (a5)
X         beq.s    usage          ; a result of zero means wrong option
X         bra.s    getnext
Xnext:
X         tst.b    (a1)
X         bne.s    getopt
Xusage:
X         Base     Dos
X         Call     Output
X         move.l   d0,d1
X         move.l   a3,d2
X         Call     Write
X         bra      noscreen       ; draw nothing
Xoptions_done:
X
X* Screen to display the new map.
X         lea      MyNewScreen,a0
X         Base     Intuition
X         Call     OpenScreen
X         move.b   #ERROR_noscreen,error
X         move.l   d0,MyScreen
X         beq      noscreen
X         move.l   d0,a2
X
X         move.l   a2,InsertScreen1
X         move.l   a2,InsertScreen2
X
X         lea      sc_ViewPort(a2),a3
X
X* First window that takes over entire screen
X         lea      MyNewWindow1,a0
X         Call     OpenWindow
X         move.b   #ERROR_nowindow,error
X         move.l   d0,MyWindow1
X         beq      nowindow
X
X* This version fetches windows rastport.
X         move.l   d0,a0
X         move.l   wd_RPort(a0),a2
X         move.l   a2,mb_RastPort(a4)
X
X         move.l   a3,a0
X         lea      Colors,a1
X         moveq    #(1<<DEPTH),d0
X         Base     Gfx
X         Call     LoadRGB4
X
X* Now get a TmpRas to screen
X         move.l   #RASSIZE,d0
X         moveq    #MEMF_CHIP,d1
X         move.l   d1,d2
X         Base     Exec
X         Call     AllocMem
X         move.b   #ERROR_nomem,error
X         move.l   d0,Mem1
X         beq      nomem1
X         lea      MyTmpRas,a3
X         move.l   d0,a1
X         move.l   a3,a0
X         move.l   d2,d0
X         Base     Gfx
X         Call     InitTmpRas
X         move.l   a3,rp_TmpRas(a2)
X
X         move.l   #MAXVECT*5,d0
X         moveq    #0,d1
X         Base     Exec
X         Call     AllocMem
X         move.l   d0,Mem2
X         beq      nomem2
X         lea      MyAreaInfo,a3
X         move.l   a3,a0
X         move.l   d0,a1
X         move.l   #MAXVECT,d0
X         Base     Gfx
X         Call     InitArea
X         move.l   a3,rp_AreaInfo(a2)
X
X         move.b   #ERROR_none,error
X* main loop if 'interactive'
Xloop:
X         move.l   Magnify,d0
X         move.l   #MAX_M,d1
X         cmp.l    d1,d0
X         bls.s    1$
X         move.l   d1,d0
X1$:
X         move.l   #MIN_M,d1
X         cmp.l    d1,d0
X         bhs.s    2$
X         move.l   d1,d0
X2$:
X         move.l   d0,Magnify
X         bsr      Transform
X         move.l   Magnify,OldMagnify
X
X* This is why we did all the above... and will be doing all the below...
X* Draw mandelbrot!
X         move.l   a4,a0
X         jsr      MandelBrot
X
X         tst.b    inter
X         beq      exit        ; user didnt want us to be interactive.
X
X* A friend of mine once pointed out that the doings of my
X* programs are often commented to be done by "we". Don't know why.
X
X* Perhaps I think my program is a person, and we are doing the
X* thing together, I by designing the program, and the program
X* in turn by running it.
X
X* One of these days, I may actually begin to talk to my programs.
X* Is that all right to you, my tiny little proggie?
X
X         bsr      calculate
Xreopen:
X* Open another window
X         lea      MyNewWindow2,a0
X         Base     Intuition
X         Call     OpenWindow
X         move.l   d0,MyWindow2
X         beq      exit_dont_save      ; could not get memory
X* Thenafter, refresh allll gadgets.
X
X* This gives refresh_m and refresh_z a hassle-free operation
X         move.b   method,d7
X         move.b   #RESET,method
X
X         move.l   CurrentX,d0
X         bsr      refresh_x
X         move.l   CurrentY,d0
X         bsr      refresh_y
X         move.l   Magnify,d0
X         bsr      refresh_m
X         move.w   mb_i(a4),d0
X         bsr      refresh_i
X         move.l   Zoom,d0
X         bsr      refresh_z
X
X         move.b   d7,method
X
X         bsr      refresh_set
X         bsr      refresh_zoom   ; this does also DrawGrid
X
Xmsgloop:
X         bsr      GetMessage
X         bne      exitloop        ; nonzero if user issued break
Xgotmessage:
X         Base     Intuition
X         cmp.l    #CLOSEWINDOW,d2
X         bne.s    no_close
X
X
X* Info window is about to be closed. Hide also title bar.
X         move.l   MyWindow2,a0
X
X* This copies both LeftEdge and TopEdge to NewWindow structure
X* This way when the window is opened again, it will be in same place.
X         move.l   wd_LeftEdge(a0),MyNewWindow2
X         Call     CloseWindow
X         clr.l    MyWindow2   ; This window is closed
X         move.l   MyScreen,a0
X         moveq    #FALSE,d0
X         Call     ShowTitle
X         bsr      RemoveGrid
X
X* Resume when either button pressed
Xget_it:  bsr      GetMessage
X         bne      exit        ; break, no need to close window
X         cmp.l    #MOUSEBUTTONS,d2
X         bne.s    get_it      ; wait for it to happen
X
X* Restore all
X         bsr      DrawGrid
X         move.l   MyScreen,a0
X         moveq    #TRUE,d0
X         Base     Intuition
X         Call     ShowTitle
X         bra      reopen      ; resume window
X
X
Xno_close:
X         cmp.l    #MOUSEMOVE,d2
X         bne.s    no_move
X         bsr      dispCoords  ; All we do here is to display current
X         bra.s    msgloop     ; coordinates
X
X
Xno_move:
X         cmp.l    #MOUSEBUTTONS,d2
X         bne.s    no_buttons
X         cmp.w    #SELECTDOWN,d3
X         bne.s    no_left_button
X         bsr      LeftButton     ; 3 things might get returned:
X         beq      msgloop     ; finished
X         bmi      exitloop    ; ^C
X         bra      zoom_draw   ; There has been a double-click -> Draw!
Xno_left_button:
X         cmp.w    #MENUDOWN,d3
X         bne.s    no_buttons
X         bsr      RightButton
X         bne      exitloop
X         bra      msgloop
Xno_buttons:
X
X         cmp.w    #GADGETDOWN,d2
X         bne.s    no_gadg_down
X         move.w   gg_GadgetID(a5),d1   ; Gadget's ID.
X         move.w   d1,d0
X         and.w    #STRING,d0
X         beq.s    not_string_gadget
X
X         bsr      StringGadgetDown  ; we also get one message here.
X         bne      exitloop          ; sigh. (l)user wants to get rid of us
X         bra      gotmessage        ; yeah, we've already got one.
Xnot_string_gadget:
X         bsr      OtherGadgetDown   ; Three things might return from this:
X         bmi.s    zoom_draw         ; negative if zoom
X         bne      exitloop          ; positive if exit
X
Xno_gadg_down:
X         cmp.l    #RAWKEY,d2
X         bne.s    no_rawkey
X         cmp.w    #$21,d3           ; RAW key code for 'S'
X         bne.s    no_rawkey
X         btst     #IEQUALIFIERB_CONTROL,d4
X         beq.s    no_rawkey
X         move.l   MyWindow2,a0
X         move.l   wd_LeftEdge(a0),MyNewWindow2  ; See previous CloseWindow
X         Call     CloseWindow
X         clr.l    MyWindow2      ; This window is closed
X         move.l   MyScreen,a0
X         moveq    #FALSE,d0
X         Call     ShowTitle
X         bsr      RemoveGrid
X
X         bsr      SavePicture
X
X         bsr      DrawGrid
X         move.l   MyScreen,a0
X         moveq    #TRUE,d0
X         Base     Intuition
X         Call     ShowTitle
X         bra      reopen      ; open window again
X
Xno_rawkey:
X         bra      msgloop           ; and zero if nothing
X
Xzoom_draw:
X         move.l   MyWindow2,a0
X         Base     Intuition
X         move.l   wd_LeftEdge(a0),MyNewWindow2  ; See previous CloseWindow
X         Call     CloseWindow
X         bsr      RemoveGrid
X         cmp.b    #ZOOM,method
X         beq.s    1$
X         cmp.b    #REDRAW,method
X         beq.s    2$
X         move.l   #NORMAL_M,Magnify
X         move.l   #NORMAL_X,CurrentX
X         move.l   #NORMAL_Y,CurrentY
X         bra      loop
X1$:
X         move.l   Zoom,d0
X         add.l    d0,Magnify
X2$:
X         bra      loop
X
X
X
X
Xexitloop:
X* Close window
X         move.l   MyWindow2,a0
X         Base     Intuition
X         Call     CloseWindow
X         bsr      RemoveGrid
X
X* Leave ship
Xexit:
X* If non-interactive and user explicitely set -s option, save picture.
X         tst.b    inter
X         bne.s    exit_dont_save
X         tst.b    saveit
X         beq.s    exit_dont_save
X         bsr      SavePicture
Xexit_dont_save
X         move.l   MyScreen,a0
X         moveq    #FALSE,d0
X         Base     Intuition
X         Call     ShowTitle
X
X         move.l   Mem2,a1
X         move.l   #5*MAXVECT,d0
X         Base     Exec
X         Call     FreeMem
Xnomem2:
X         move.l   Mem1,a1
X         move.l   #RASSIZE,d0
X         Base     Exec
X         Call     FreeMem
Xnomem1:
X         Base     Intuition
X         move.l   MyWindow1,a0
X         Call     CloseWindow
Xnowindow:
X         move.l   MyScreen,a0
X         Call     CloseScreen
Xnoscreen:
X         lea      MsgPort,a0
X         move.b   MP_SIGBIT(a0),d0
X         Base     Exec
X         Call     FreeSignal
Xnosignal:
X         lea      IOreq,a1
X         Call     CloseDevice
Xtimererr:
X         move.l   _GfxBase,a1
X         Call     CloseLibrary
Xnogfx:
X         move.l   _IntuitionBase,a1
X         Call     CloseLibrary
Xnointui:
X         tst.b    error
X         beq.s    close_dos   ; no error
X
X         Base     Dos
X         tst.l    WBmessage
X         beq.s    CLI_2
X         lea      stdout_name,a0
X         move.l   a0,d1
X         move.l   #MODE_NEWFILE,d2
X         Call     Open
X         tst.l    d0
X         beq.s    close_dos
X         bra.s    common_code2
XCLI_2
X         Call     Output
Xcommon_code2
X         move.l   d0,d4       ; save file handle for further use
X
X* First, output our name.
X         move.l   d4,d1
X         move.l   MyName,d2
X         move.w   MyNameLen,d3
X         ext.l    d3
X         Call     Write
X
X* Then, the error message.
X         move.l   d4,d1
X         move.b   error,d0
X         ext.w    d0
X         lsl.w    #2,d0
X         lea      errors,a0
X         move.l   0(a0,d0.w),a0
X         move.l   a0,d2
X         moveq    #-1,d3
X1$
X         addq.l   #1,d3
X         tst.b    (a0)+
X         bne.s    1$
X         Call     Write
X
X         tst.l    WBmessage
X         beq.s    close_dos
X         move.l   #2*TICKS_PER_SECOND,d1
X* REM ALLOW TIME FOR USER TO RELEASE BUTTON FROM LAST PUSH
X         Call     Delay
X         move.l   d4,d1
X         Call     Close       ; close stdout window
Xclose_dos
X         Base     Exec
X         move.l   _DosBase,a1
X         Call     CloseLibrary
X         move.l   WBmessage,d0
X         beq.s    nodos
X         Call     Forbid
X         move.l   d0,a1
X         Call     ReplyMsg       ; Now WB knows we are safe to get rid of
Xnodos:
X         moveq    #0,d0
X         move.b   error,d0
X         beq.s    2$
X         moveq    #RETURN_FAIL,d0
X2$:
X         pull     d1-d7/a0-a6
X         rts
X
XRemoveGrid:
X         tst.b    isdrawn
X         beq      nothing_to_remove
X
X         push     d0-d2/a0-a2/a6
X
X         Base     Intuition
X         move.l   MyWindow1,a0
X         move.l   wd_RPort(a0),a2
X
X* DrawGrid has conveniently set up some values for me. How nice of him!
X         move.w   centerx,d0
X         move.w   centery,d1
X         move.l   pic_c,a1
X         bsr.s    remove_1
X
X         move.w   lowx,d0
X         move.w   lowy,d1
X         move.l   pic_tl,a1
X         bsr.s    remove_1
X
X         move.w   lowx,d0
X         move.w   highy,d1
X         move.l   pic_bl,a1
X         bsr.s    remove_1
X
X         move.w   highx,d0
X         move.w   lowy,d1
X         move.l   pic_tr,a1
X         bsr.s    remove_1
X
X         move.w   highx,d0
X         move.w   highy,d1
X         move.l   pic_br,a1
X         bsr.s    remove_1
X
X         clr.b    isdrawn
X         pull     d0-d2/a0-a2/a6
Xnothing_to_remove:
X         rts
X
Xremove_1:
X         move.l   a2,a0
X         move.l   a1,d2
X         beq.s    1$
X         Call     DrawBorder
X1$:      rts
X
X
XDrawGrid:
X         bsr      RemoveGrid
X         cmp.b    #ZOOM,method
X         beq.s    draw_yes
X         cmp.b    #RESET,method
X         beq      draw_over
X         move.l   Magnify,d0
X         cmp.l    OldMagnify,d0
X         bne      draw_over
Xdraw_yes:
X         push     a0-a2/a6/d0-d7
X         move.l   prex,d0
X         move.l   prey,d1
X         move.b   #TRUE,isdrawn
X
X         move.l   d0,prex
X         move.l   d1,prey
X         move.l   #$8000,d2      ; round
X         add.l    d2,d0
X         add.l    d2,d1
X
X         move.l   d0,d4
X         move.l   d1,d5
X
X         swap     d0
X         swap     d1
X
X         moveq    #0,d2          ; record # of crossings
X         Base     Intuition
X         lea      Cross,a1
X         move.l   MyWindow1,a0
X         move.l   wd_RPort(a0),a2
X
X         cmp.w    mb_x1(a4),d0
X         bge.s    1$
X         move.w   mb_x1(a4),d0
X         lea      LeftLeft,a1
X         addq.w   #1,d2
X1$:
X         cmp.w    mb_x2(a4),d0
X         ble.s    2$
X         move.w   mb_x2(a4),d0
X         lea      RightRight,a1
X         addq.w   #1,d2
X2$:
X         cmp.w    mb_y1(a4),d1
X         bge.s    3$
X         move.w   mb_y1(a4),d1
X         lea      UpUp,a1
X         addq.w   #1,d2
X3$:
X         cmp.w    mb_y2(a4),d1
X         ble.s    4$
X         move.w   mb_y2(a4),d1
X         lea      DownDown,a1
X         addq.w   #1,d2
X4$:
X         cmp.w    #1,d2       ; only 1 crossing allowed
X         bls.s    ok_to_disp
X         clr.l    pic_c
X         bra.s    cross_over
Xok_to_disp:
X         move.w   d0,centerx
X         move.w   d1,centery
X
X         move.l   a2,a0
X         move.l   a1,pic_c
X         Call     DrawBorder
Xcross_over:
X         move.w   mb_x2(a4),d0
X         sub.w    mb_x1(a4),d0
X         move.l   Zoom,d3
X
X         cmp.b    #REDRAW,method ; if redraw, grid has size of screen
X         bne.s    revolution
X         moveq    #0,d3
Xrevolution:
X         add.l    #$10000,d3
X         bmi      pig_big
X
X         moveq    #0,d1
X         moveq    #0,d2
X         bsr      Power2
X* Hey! What are you doing?
X* We will find how long the side of the grid should be.
X* If Zoom < -$10000, it wont fit on the screen same time as
X* crosshairs. And adding $10000 means halving the distance,
X* and as it happens, that is just what we want!
X         move.l   d0,d6
X
X         move.w   mb_y2(a4),d0
X         sub.w    mb_y1(a4),d0
X         bsr      Power2         ; d1-d3 remain!
X         move.l   d0,d7
X
X         move.l   d4,d2
X         move.l   d5,d3
X         sub.l    d6,d2          ; note! d7 has a remainder similar to
X         sub.l    d7,d3          ; that of d4
X         add.l    d6,d4
X         add.l    d7,d5
X         swap     d2
X         swap     d3
X         swap     d4
X         swap     d5
X
X         moveq    #0,d6
X         move.w   mb_x1(a4),d0
X         move.w   mb_x2(a4),d1
X         cmp.w    d0,d2
X         bge.s    1$
X         move.w   d0,d2
X         bset     #0,d6
X1$:
X         cmp.w    d1,d2
X         bgt      pig_big
X         cmp.w    d1,d4
X         ble.s    2$
X         move.w   d1,d4
X         bset     #1,d6
X2$:
X         cmp.w    d0,d4
X         blt      pig_big
X         move.w   mb_y1(a4),d0
X         move.w   mb_y2(a4),d1
X         cmp.w    d0,d3
X         bge.s    3$
X         move.w   d0,d3
X         bset     #2,d6
X3$:
X         cmp.w    d1,d3
X         bgt      pig_big
X         cmp.w    d1,d5
X         ble.s    4$
X         move.w   d1,d5
X         bset     #3,d6
X4$:
X         cmp.w    d0,d5
X         blt      pig_big
X
X         move.w   d2,lowx
X         move.w   d3,lowy
X         move.w   d4,highx
X         move.w   d5,highy
X
X* process the corners.
X         push     a3-a5    ; NEED some workspace
X         lea      TopLeft,a1
X         lea      BottomLeft,a3
X         lea      TopRight,a4
X         lea      BottomRight,a5
X         btst.b   #0,d6
X         beq      no_left
X         lea      LeftLeft,a1
X         move.l   a1,a3
Xno_left:
X         btst.b   #1,d6
X         beq.s    no_right
X         lea      RightRight,a4
X         move.l   a4,a5
Xno_right:
X         btst.b   #2,d6
X         beq.s    no_up
X         lea      UpUp,a1
X         move.l   a1,a4
Xno_up:
X         btst.b   #3,d6
X         beq.s    no_down
X         lea      DownDown,a3
X         move.l   a3,a5
Xno_down:
X         not.b    d6
X         move.b   d6,d0
X         and.b    #%0101,d0
X         bne.s    skip_tl
X         sub.l    a1,a1
Xskip_tl:
X         move.b   d6,d0
X         and.b    #%1001,d0
X         bne.s    skip_bl
X         sub.l    a3,a3
Xskip_bl:
X         move.b   d6,d0
X         and.b    #%0110,d0
X         bne.s    skip_tr
X         sub.l    a4,a4
Xskip_tr:
X         and.b    #%1010,d6
X         bne.s    skip_br
X         sub.l    a5,a5
Xskip_br:
X         move.l   a2,a0
X         move.l   a1,pic_tl
X         beq.s    no_tl
X         move.w   d2,d0
X         move.w   d3,d1
X         Call     DrawBorder
Xno_tl:
X         move.l   a3,a1
X         move.l   a2,a0
X         move.l   a1,pic_bl
END_OF_FILE
if test 26145 -ne `wc -c <'source/gui.asm.aa'`; then
    echo shar: \"'source/gui.asm.aa'\" unpacked with wrong size!
fi
# end of 'source/gui.asm.aa'
fi
echo shar: End of archive 3 \(of 4\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 4 archives.
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
--
Mail submissions (sources or binaries) to <[e-mail]>.
Mail comments to the moderator at <[e-mail]>.
Post requests for sources, and general discussion to comp.sys.amiga.misc.